home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / self / contrib.lha / contrib / 491 / navel / view.self < prev    next >
Encoding:
Text File  |  1993-07-22  |  7.8 KB  |  314 lines
  1. "view.self,v 1.8 1993/07/22 00:15:49 richards Exp"
  2. "views - a simple X interface and widget set for Self"
  3.  
  4. "This is it - the VIEW object"
  5.  
  6. "views 
  7.     display a model
  8.     use a viewManager for the workstation display
  9.     are contained within a superView (window that is the parent)
  10.         currently nil for a topView.
  11. "
  12.  
  13. "remember lots of things like destroy, map, etc are just requests
  14. and lots of things, like resize calculations are better done on the
  15. arrival of events than the sending of the request"
  16.  
  17. traits views _AddSlotsIfAbsent: (| ^ view = () |)
  18. traits views view _Define: (|
  19.  
  20.     parent*** = traits abstractView.
  21.     identity** = mixins identity.
  22.     eventMixin**** = viewManager eventMixin.
  23.  
  24.     "Opening (realising) a view does not create a copy.
  25.      Also, once a view has been closed, it can be happily
  26.      reopened if necessary. Remember open != show, close != hide
  27.      (in X terms realise != map, unrealise != unmap)"
  28.  
  29.     ^ copyMapped = (copyRealised map).
  30.     ^ copyMapped: vmgr = ((copyRealised: vmgr) map).
  31.     ^ copyRealised = (copy realise).
  32.     ^ copyRealised: vmgr = (copy realise: vmgr).
  33.     
  34.     "should only be called indirectly (see above)
  35.      but this is the place to override copy"
  36.  
  37.     "this code must be kept in step with the unrealise code"
  38.     
  39.     "_" copyUnrealised: sv = (|c|
  40.     c: resend.copyUnrealised: sv.
  41.     
  42.     "the following are deleted"
  43.     c window: window deadCopy.
  44.     c manager: nil.
  45.     c display: nil.
  46.     
  47.     "the following flags reset"
  48.     c iMapped: false.
  49.     
  50.     c
  51.     ).
  52.     
  53.  
  54.  
  55.     opening* = (|
  56.     ^ open = (realise).
  57.     ^ open: name = (realise).
  58.     ^ open: name Manager: vmgr = (realise: vmgr).
  59.     
  60.     ^ realise = (
  61.         isTopView 
  62.           ifTrue: [realise: viewManager someManager]
  63.           False: [realise: superView manager].
  64.     ).
  65.  
  66.     ^ realise: vmgr = (|new|
  67.  
  68.         "override to check the subView structure, if nec"
  69.         "the view should now be sane..."
  70.  
  71.         isTopView 
  72.           ifTrue: ["setup topView Behaviour"]
  73.           False: ["setup normalView behaviour" "check superView"
  74.         (superView isRealised)
  75.               ifFalse: [error: 'need a realised superView to realise'].
  76.         (superView manager == vmgr) 
  77.               ifFalse: [error: 'need the same manager as my superView'].
  78.         ].
  79.         
  80.         vmgr isOpen
  81.           ifFalse: [error: 'I need an open manager to realise upon'].
  82.         
  83.         "I'm not sure what this should do.."
  84.         isRealised 
  85.           ifTrue: [warning: 'I can only realise myself _once_'. ^self].
  86.         
  87.         "here we go"
  88.         
  89.         new: xlib window
  90.           createDisplay: vmgr display SubWindow:
  91.           (superView isNil ifTrue: [vmgr display screen rootWindow]
  92.               False: [superView window])
  93.           X: x Y: y Width: width Height: height
  94.           BorderWidth: borderWidth
  95.           Border: (vmgr pixel: borderColour)
  96.           Background: (vmgr pixel: background).
  97.         
  98.         new isNull ifTrue: [^error: 'couldn\'t create window'].
  99.         
  100.         "done it, so register with manager"
  101.  
  102.         "should be the _only_ assignment to window, display, manager"
  103.         window: new.
  104.         
  105.         "configure the view"
  106.         vmgr manage: self For: window.
  107.         manager: vmgr.
  108.         display: vmgr display.
  109.  
  110.         "configure the window"
  111.         name: name.
  112.         iconName: iconName.
  113.         icon: icon.
  114.         window eventMask: iEventMask.
  115.         window selectInput.
  116.  
  117.         self).
  118.  
  119.     ^ isRealised = (window isLive).
  120.     ^ isReal = (isRealised).
  121.     
  122.     "if theres too much of this, try dynamic inheritance"
  123.     "WARNING: THIS RETURNS SELF"
  124.     _ ifRealised: b = (ifRealised: b Else: 
  125.           [debugMessage: 'view: ', iName, ' is currently unrealised']).
  126.     _ ifRealised: b Else: e = (isRealised ifTrue: b False: e. self).
  127.     |).
  128.  
  129.  
  130.     closing* = (|
  131.  
  132.     "this code must be kept in step with the copyUnrealised code"
  133.     "the meanings of the variables are documted there"
  134.  
  135.     "we nuke the window, then catch destroy notify!"
  136.     "subWindows will get taken out by X"
  137.  
  138.     ^ close = (unrealise).
  139.     ^ destroy = (unrealise).
  140.     
  141.     ^ unrealise = (ifRealised: [window destroy. basicUnrealise]).
  142.     
  143.     "this should be called to unrealise a view"
  144.     "after it's window _(or superView's window) has been destroyed"
  145.     ^ basicUnrealise = (ifRealised: [
  146.         
  147.         manager release: self For: window.
  148.         
  149.         manager: nil.
  150.         display: nil.
  151.         window: window deadCopy.
  152.         
  153.         iMapped: false.
  154.         
  155.         ]).
  156.     
  157.     |). 
  158.     
  159.     showing* = (|
  160.     ^ show = (map).
  161.     ^ hide = (unmap).
  162.     ^ mapped = (iMapped).
  163.     ^ map = (ifRealised: [window map]. iMapped: true.).
  164.     ^ unmap = (ifRealised: [window unmap]. iMapped: true.).
  165.     |).
  166.     
  167.     eventMasking* = (|
  168.     ^ eventMask = (iEventMask).
  169.     ^ eventMaskAdd: m = (eventMask: iEventMask || m).
  170.     ^ eventMaskRemove: m = (eventMask: iEventMask && (m complement)).
  171.     ^ eventMask: m = (iEventMask: m. 
  172.         ifRealised: [window eventMask: m. window selectInput]).
  173.     |).
  174.     
  175.     xEvents* = (|
  176.     mapNotify: event = (iMapped: true).            
  177.     unmapNotify: event = (iMapped: false).
  178.  
  179.     ^ buttonPress: event = (
  180.         (event button == 1) ifTrue: [selectDown: event x @ event y].
  181.         (event button == 2) ifTrue: [copyDown: event x @ event y].
  182.         (event button == 3) ifTrue: [menuDown: event x @ event y].
  183.         self
  184.     ).
  185.  
  186.     ^ buttonRelease: event = (
  187.         (event button == 1) ifTrue: [selectUp: event x @ event y].
  188.         (event button == 2) ifTrue: [copyUp: event x @ event y].
  189.         (event button == 3) ifTrue: [menuUp: event x @ event y].
  190.         self
  191.     ).
  192.     |).
  193.     
  194.     viewEvents* = (|
  195.     ^ selectDown: pt = (42).
  196.     ^ selectUp: pt   = (42).
  197.  
  198.     ^ copyDown: pt = (42).
  199.     ^ copyUp: pt = (42).
  200.  
  201.     ^ menuDown: pt = (42).
  202.     ^ menuUp: pt   = (42).
  203.     |).
  204.  
  205.  
  206.     gunk* = (|
  207.     ^ flush = (ifRealised: [display flush]).
  208.     |).
  209.     
  210.     printing* = (|
  211.     printString = ('heavyView: ',iName).
  212.     |).
  213.  
  214.     drawing* = (|
  215.     clear = (window clear).
  216.     drawAt: p String: s = (
  217.         window drawString: s At: p GC: manager gc
  218.     ).
  219.     drawAt: p String: s InFont: fontStruct = ( | lgc. |
  220.         lgc: manager gcForFont: fontStruct fid.
  221.         window drawString: s At: p GC: lgc.
  222.     ).
  223.     drawFrom: o To: c Width: w = (| lgc. |
  224.         lgc: manager gcWidth: w.
  225.         window drawLine: o To: c GC: lgc
  226.     ).
  227.     drawFrom: o To: c = (| lgc. |
  228.         lgc: manager gcWidth: 1.
  229.         window drawLine: o To: c GC: lgc
  230.     ).
  231.     drawLine: r = (
  232.         drawFrom: r origin To: r corner + 1
  233.     ).
  234.     drawFrom: o For: c = (
  235.         drawFrom: o To: o + c
  236.     ).
  237.     drawXorRectangleFrom: o To: c = (| lgc. |
  238.         lgc: manager gcFunction: xlib graphicsContext gxXor.
  239.         window fillRectangleFrom: o To: c GC: lgc.
  240.     ).
  241.     drawXorRectangle: rect = (| lgc. |
  242.         lgc: manager gcFunction: xlib graphicsContext gxXor.
  243.         window drawRectangle: rect GC: lgc.
  244.     ).
  245.     fillRectangle: rect = (
  246.         window drawRectangle: rect GC: manager gc.
  247.     ).
  248.     clearRectangle: rect = (| lgc. |
  249.         lgc: manager gcFunction: xlib graphicsContext gxClear.
  250.         window drawRectangle: rect GC: lgc.
  251.     ).
  252.     |).
  253.  
  254.     fonts* = (|
  255.     drawAt: p String: s InFontNamed: fname = (
  256.         debugMsg: ('Asked to print: ',s,' at: ',p printString).
  257.         drawAt: p String: s InFont: (manager openFontNamed: fname).
  258.     ).
  259.     drawInFixedFontAt: p String: s = (
  260.         drawAt: p String: s InFontNamed: 'fixed'.
  261.     ).
  262.             
  263.     openFontNamed: fname = (
  264.         manager openFontNamed: fname
  265.     ).
  266.  
  267.     textAscent: string = ( | fs. |
  268.         fs: openFontNamed: 'fixed'.
  269.         fs ascent
  270.     ).
  271.     
  272.     textHeight: string = ( | fs. |
  273.         fs: openFontNamed: 'fixed'.
  274.         fs ascent + fs descent
  275.     ).
  276.     
  277.     textWidth: string = ( | fs. |
  278.         fs: openFontNamed: 'fixed'.
  279.         fs xTextWidth: string
  280.     ).
  281.         
  282.     ^ debugMsg: msg = (
  283.         debugFlag ifTrue: [
  284.         msg printLine.
  285.         ].
  286.     ).
  287.     |).
  288.  
  289.     heavySuperView = ( self ).
  290.     isHeavy = ( true ).
  291.     isLight = ( false ).
  292. |)
  293.  
  294. prototypes views _AddSlotsIfAbsent: (| ^ view = () |)
  295.  
  296. prototypes views view _Define: prototypes views abstractView "get super vars "
  297. prototypes views view _AddSlots: (|
  298.     parent* = traits view.
  299.     
  300.     ^_ window <- xlib window. "I can't make up my mind about this"
  301.     ^_ manager <- nil.
  302.     ^_ display <- nil.
  303.     
  304.     _ iMapped <- false.
  305.     
  306.     _ iEventMask <- xlib events exposureMask ||
  307.     xlib events structureNotifyMask.
  308.     
  309.     _ iBorderWidth <- 1.
  310.     _ iBorderColour <- 'black'.
  311.     _ iBackground <- 'white'.
  312.     
  313. |)
  314.